home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Database How-To / Visual Basic 4 Database - How-to (The Waite Group)(1995).iso / select3.fr_ / select3.fr
Text File  |  1995-07-04  |  7KB  |  222 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Variable SELECTer"
  5.    ClientHeight    =   4665
  6.    ClientLeft      =   1770
  7.    ClientTop       =   1860
  8.    ClientWidth     =   7575
  9.    Height          =   5070
  10.    Left            =   1710
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   4665
  13.    ScaleWidth      =   7575
  14.    Top             =   1515
  15.    Width           =   7695
  16.    Begin VB.TextBox txtYearPublished 
  17.       Height          =   285
  18.       Left            =   6120
  19.       TabIndex        =   3
  20.       Top             =   1740
  21.       Width           =   915
  22.    End
  23.    Begin VB.CommandButton cmdClose 
  24.       Caption         =   "Close"
  25.       Default         =   -1  'True
  26.       BeginProperty Font 
  27.          name            =   "MS Sans Serif"
  28.          charset         =   0
  29.          weight          =   700
  30.          size            =   8.25
  31.          underline       =   0   'False
  32.          italic          =   0   'False
  33.          strikethrough   =   0   'False
  34.       EndProperty
  35.       Height          =   555
  36.       Left            =   3120
  37.       TabIndex        =   2
  38.       Top             =   3780
  39.       Width           =   1335
  40.    End
  41.    Begin VB.ListBox lstTitles 
  42.       Height          =   1035
  43.       Left            =   480
  44.       TabIndex        =   1
  45.       Top             =   2160
  46.       Width           =   6555
  47.    End
  48.    Begin VB.Data Data1 
  49.       Caption         =   "Data1"
  50.       Connect         =   "Access"
  51.       DatabaseName    =   "C:\VB\BIBLIO.MDB"
  52.       Exclusive       =   0   'False
  53.       Height          =   300
  54.       Left            =   480
  55.       Options         =   0
  56.       ReadOnly        =   0   'False
  57.       RecordsetType   =   2  'Snapshot
  58.       RecordSource    =   "SELECT [Company Name] FROM [Publishers]  ORDER BY [Company Name]"
  59.       Top             =   1800
  60.       Visible         =   0   'False
  61.       Width           =   2115
  62.    End
  63.    Begin VB.Label Label1 
  64.       AutoSize        =   -1  'True
  65.       BackColor       =   &H00C0C0C0&
  66.       Caption         =   "Year Published:"
  67.       BeginProperty Font 
  68.          name            =   "MS Sans Serif"
  69.          charset         =   0
  70.          weight          =   700
  71.          size            =   8.25
  72.          underline       =   0   'False
  73.          italic          =   0   'False
  74.          strikethrough   =   0   'False
  75.       EndProperty
  76.       Height          =   195
  77.       Left            =   4680
  78.       TabIndex        =   4
  79.       Top             =   1800
  80.       Width           =   1350
  81.    End
  82.    Begin MSDBCtls.DBList dblPublishers 
  83.       Bindings        =   "SELECT3.frx":0000
  84.       Height          =   840
  85.       Left            =   480
  86.       TabIndex        =   0
  87.       Top             =   360
  88.       Width           =   5175
  89.       _Version        =   65536
  90.       _ExtentX        =   9128
  91.       _ExtentY        =   1482
  92.       _StockProps     =   77
  93.       BackColor       =   -2147483643
  94.       MatchEntry      =   1
  95.       ListField       =   "Company Name"
  96.       BoundColumn     =   "Name"
  97.    End
  98. End
  99. Attribute VB_Name = "Form1"
  100. Attribute VB_Creatable = False
  101. Attribute VB_Exposed = False
  102. Option Explicit
  103.     
  104. ' Change the following to point to your copy of BIBLIO.MDB.
  105.     
  106. Dim db As DATABASE
  107.  
  108. Private Sub Form_Load()
  109.     On Error GoTo FormLoadError
  110.     Dim dbName As String
  111.     
  112.    ' Get the database name and open the database.
  113.     dbName = BiblioPath()       ' BiblioPath is a function in READINI.BAS
  114.     Set db = DBEngine.Workspaces(0).OpenDatabase(dbName)
  115. Exit Sub
  116.  
  117. FormLoadError:
  118.  
  119.     ' Just display Visual Basic's default error message.
  120.     MsgBox Error(Err)
  121.     
  122. Exit Sub
  123.  
  124. End Sub
  125.  
  126. Private Sub dblPublishers_Click()
  127.     ' Open a snapshot-type recordset on the [Titles] Table, selecting only
  128.     ' those titles published by the selected publishing company and (if the
  129.     ' user has entered a publication year) in the designated year. Sort the
  130.     ' records by the ISBN number.
  131.     Dim rs As Recordset
  132.     Dim sql As String
  133.     Dim yrPublished As Integer
  134.     
  135.     ' Set up the error handler.
  136.     
  137.     On Error GoTo PublishersClickError
  138.         
  139.     ' Clear any existing data in the Titles list box.
  140.     lstTitles.Clear
  141.     
  142.     ' Convert the text in txtYearPublished to a numeric value.
  143.     ' If there is no text or if it is non-numeric, the value will be 0.
  144.     If IsNumeric(txtYearPublished) Then yrPublished = Val(txtYearPublished)
  145.         
  146.     ' Build the SQL statement.
  147.     sql = "SELECT [Title], [ISBN] FROM [Titles]"
  148.     
  149.     ' Call the function GetPubID(), which returns the PubID that
  150.     ' corresponds to the currently selected item in dblPublishers.
  151.     sql = sql & " WHERE [PubID] = " & GetPubID()
  152.     
  153.     ' If the user entered a numeric value in the Year Published box,
  154.     ' append that year to the WHERE clause as an additional criterion.
  155.     
  156.     If yrPublished > 0 Then
  157.         sql = sql & " AND [Year Published] = " & yrPublished
  158.     End If
  159.     
  160.     ' Append the ORDER clause to the SQL statement.
  161.     sql = sql & " ORDER BY [ISBN]"
  162.     
  163.     ' Use the SQL statement as the recordset definition to open a titles
  164.     ' recordset.
  165.     Set rs = db.OpenRecordset(sql, dbOpenSnapshot)
  166.     
  167.     ' If there is at least one record in the recordset, move through the
  168.     ' recordset a record at a time until the end of the file (EOF) is
  169.     ' reached. Display each record in the unbound list box lstTitles.
  170.     If rs.RecordCount > 0 Then
  171.         rs.MoveFirst
  172.         Do While Not rs.EOF
  173.             lstTitles.AddItem rs![ISBN] & ": " & rs![Title]
  174.             rs.MoveNext
  175.         Loop
  176.     End If
  177.     
  178. Exit Sub
  179.     
  180. PublishersClickError:
  181.  
  182.     ' Just display Visual Basic's default error message.
  183.     MsgBox Error(Err)
  184.     
  185. Exit Sub
  186.  
  187. End Sub
  188.  
  189. Function GetPubID() As Long
  190.     Dim rs As Recordset
  191.     Dim sql As String
  192.     
  193.     ' Build the SQL statement.
  194.     sql = "SELECT [PubID] FROM [Publishers]"
  195.     
  196.     ' Use the text currently selected in the Publishers list box as the
  197.     ' criterion for selecting a record from the Publishers table. Because
  198.     ' the value being used as a criterion is a string (text) value, it
  199.     ' must be delimited by double quotes.
  200.     sql = sql & " WHERE [Company Name] = """ & dblPublishers.TEXT & """"
  201.     
  202.     ' Use the SQL statement as the recordset definition to open a titles
  203.     ' recordset.
  204.     Set rs = db.OpenRecordset(sql, dbOpenSnapshot)
  205.     
  206.     ' Return the value of the [PubID] field for the record found. If no
  207.     ' record matched the criterion, return 0.
  208.     If rs.RecordCount > 0 Then
  209.         GetPubID = rs![PubID]
  210.     Else
  211.         GetPubID = 0
  212.     End If
  213.     
  214. End Function
  215.  
  216. Private Sub cmdClose_Click()
  217.     End
  218. End Sub
  219.  
  220.  
  221.  
  222.